perm filename READX.F4[MUS,LCS] blob sn#007377 filedate 1974-01-08 generic text, type T, neo UTF8
00100		SUBROUTINE READIN(SOURCE,QUANT,XOUT,FOOGY)
00200	C   UNIT GEN. 'READ' = - READ(SOURCE,QUANT,ARY1024,INPUT NCHNS);
00300	C	OUTPUTS ARE RDA, RDB, RDC AND RDD. DON'T USE U1, ETC.
00400	C   IF SOURCE<100 IT =4TH LETTER.  E.G. 4 WILL READ FROM MUSDA (4=D)
00500	C   IF SOURCE>100, LAST 2 DIGITS ARE LAST LETTER, 1ST 2 ARE 4TH LETTER.
00600	C     E.G. 312 WILL READ FROM MUSCL (3=C, 12=L).   1213 = MUSLM
00700	C   LOAD AFTER MUSX,MUSIO,NSCTAP
00800	C   MUSIO SHOULD INCLUDE MTA1 CALLS.
00900	
01000		COMMON ISAVE
01100		DIMENSION IOUT(1024),XOUT(2046),IH(5),JH(5),KNM(4),NM1(4),NM2(4)
01200		1 ,KCNT(4),XS(4)
01300	C  USES ONLY 1023 WDS OF READIN, SENDS BACK 2046 SAMPLES.
01400		DATA IH(1)/'  REA'/,IH(2)/'DING '/,IH(4)/' / '/
01500		1 ,(JH(K),K=1,3)/' END OF SECTION'/
01600		EQUIVALENCE (K,IH(5),JH(5)),(JH(4),IH(4))
01700		DO 11 K=1,4
01800		JX=K
01900	11	IF(SOURCE.EQ.XS(K))GO TO 12
02000		NS=NS+1
02100		XS(NS)=SOURCE
02200		JX=NS
02300	C   FINDS SOURCE # BEING USED NOW.
02400	12	IF(FOOGY)GO TO 1
02500	C  KSIZE IS NUM OF 36-BIT WORDS TO PROCESS.
02600		ISAVE=-1
02700		MTA=0
02800		K=QUANT-1.
02900		JC=0
03000		IF(SOURCE.LT.100.)GO TO 4
03100		NAME=SOURCE/100.
03200	C  GETS # FOR 1ST LETTER.
03300		JC=SOURCE-NAME*100
03400		IF(JC.NE.0)JC=JC-1
03500	C  GETS 2ND LETTER.
03600		JNM=NAME-1
03700		GO TO 10
03800	4	IF(SOURCE.GT.0)GO TO 2
03900		MTA=-1
04000		JNM=NAME
04100	CC**	CALL MTA1
04200		GO TO 3
04300	2	JNM=SOURCE-1.
04400	10	JNM='MUSAA'+256*JNM
04500	3	KNM=JNM
04600		NM1(JX)=JNM+JC*2
04700		NM2(JX)=JNM+2*K
04800		IF(K.GT.26)NM2(JX)=NM1(JX)+256+(K-26)*2
04900	C  AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
05000	710	IF(MTA)GO TO 811
05100	711	CALL GETFI2(NM1(JX),JX)
05200		IH(3)=NM1(JX)
05300		CALL MESS(IH)
05400		GO TO 810
05500	811	CONTINUE
05600	CC**811	CALL INMTA1(XOUT(1),128)
05700	CC**	IF(XOUT(1))GO TO 1201
05800		GO TO 610 
05900	810	CALL FASTI2(XOUT(1),128,JX)
06000		KCNT(JX)=2
06100	C  JADD IS # OF 128 WD. RECORDS READ.
06200	610	IF(MTA)GO TO 611
06300		CALL FASTI2(XOUT(1),1024,JX)
06400		KCNT(JX)=KCNT(JX)+8
06500		GO TO 612
06600	C   LAST WORD IS THROWN AWAY.
06700	611	CONTINUE
06800	CC**614	CALL MTA1
06900	CC**611	CALL INMTA1(XOUT(1),1024)
07000	612	JC=XOUT(1024)
07100		IF(JC)5,9,6
07200	5	CALL MESS(JH)
07300	6	NM1(JX)=NM1(JX)+2
07400		IF(NM1(JX).LE.JNM+50)GO TO 27
07500		JNM=JNM+256
07600	C   RAISES 'AAAZA' TO 'AABAA'
07700	1017	NM1(JX)=JNM
07800	27	IF(NM1(JX).LE.NM2(JX))GO TO 710
07900	1201	NM2(JX)=NM1(JX)-1
08000	9	RETURN
08100	1	IF(ISAVE)GO TO 171
08200		ISAVE=-1
08300		IF(NM1(JX).GT.NM2(JX))GO TO 171
08400	CC**	IF(MTA)GO TO 614
08500	C    CANNOT START UP MTA1 AGAIN IF TAPE IS MOVED.
08600		CALL GETFI2(NM1(JX),JX)
08700		CALL USETI(KCNT(JX))
08800	C*** NOT YET FIXED FOR READING MAGTAPE!!!
08900	171	IF(NM1(JX).LE.NM2(JX))GO TO 610
09000		IF(JC.EQ.-1)RETURN
09100		DO 7 K=1,2046
09200	7	XOUT(K)=0
09300		JC=-1
09400		RETURN
09500	C  ZEROS ARRAY IF NO MORE IS READ IN.
09600		END